C     FORNUTS --- FORest NUTrient Simulator
C     programmed by Stephen C. Hart    Fall 1983
C     revised by John M. Pye         Winter 1985
C
C                      ** MAIN PROGRAM **
C
      REAL LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILC,SOILN(6),NREMOV(6)
     $,NREMB(6),NREML(6),NREMS(6),NREMCR(6),NPBHAR(6),NSBHAR(6),
     $RAINNR(6),FERTNR(6),OUTNR(6),HLBMAS(6),HBBMAS(6),HSBMAS(6),
     $HCRMAS(6),HTREM(6),RTRANS,LTRANS,NINPUT,NOUTPT,LEAFNF,ROOTNF,
     $FRFPRO,PHSAGE,PBFAC,FERFAC,ISOILN
C
      INTEGER AGE,FERAGE,FERATE,FREQBN,ROTATN,MARKER,FINISH,SI,RECALL,
     $PBBURN,BURNTP,SHBURN,SBURNT,HARVT,ROTNUM,ISAGE,FTRIG,PBTRIG,NUM
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,
     $NOUTPT,FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,
     $SHBURN,SBURNT,HARVT,FERATE,FREQBN,NUM
C
      COMMON/OUT/LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILN,NREMOV,
     $NREMB,NREML,NREMS,NREMCR,NPBHAR,NSBHAR,RAINNR,FERTNR,
     $OUTNR,HLBMAS,HBBMAS,HSBMAS,HCRMAS,HTREM,ROTNUM
C
      COMMON/REPOT/ISAGE
C
      CALL BANNER
C
      CALL ZERO
C
      FTRIG=0
      PBTRIG=0
      FERFAC=0.0
      PBFAC=0.0
C
      ROTNUM=1
C
    3 CALL INPUT
C
      SOILN(ROTNUM)=ISOILN
C
      ISAGE=AGE
C                                            set initial physiol. age
      PHSAGE=FLOAT(AGE)
C
      WRITE(*,4)
    4 FORMAT(//1X,'LOOK OVER THE NEXT TWO SCREENS OF INPUT VALUES',/1X, 
     $'TO MAKE SURE THEY ARE WHAT YOU INTENDED.'/)         
      PAUSE
C
      CALL ECHO
      PAUSE
C
      RECALL=0
C
      WRITE(*,5)
    5 FORMAT(///1X,'AFTER LOOKING OVER THE INPUTS, DO YOU WANT'/
     $1X,'TO RE-ENTER THE INPUT VALUES? IF YES, ENTER 1,'/1X,
     $'IF NO, ENTER 0 --->')
      READ(*,7)RECALL
    7 FORMAT(I2)
      IF (RECALL .EQ. 1) GO TO 3
C
      FINISH=ROTATN*(NUM-1)+(ROTATN-ISAGE)+1
C	
      DO 30 I=1,FINISH
C                                          let user know its working
      WRITE(*,9)I
    9 FORMAT(/1X,'                         calculating year',I4,' now')
C
        IF (PBBURN .EQ. 0) GO TO 10
        MARKER=(AGE-PBBURN)-((AGE-PBBURN)/FREQBN)*FREQBN
        IF (MARKER.NE.0.)GO TO 10
C
        CALL PBURN(AGE,BURNTP,SOILC,SOILN,ROTNUM,PBTRIG,PBFAC,NPBHAR)
C		
   10   CONTINUE
C
       IF (AGE .EQ. FERAGE .AND. FERATE .NE. 0)
     $    CALL FERT(SOILN,FERATE,AGE,FTRIG,ROTNUM,FERFAC,FERTNR)
C
        CALL AVAILN(SOILC,SOILN,ROTNUM,LBMAS,BBMAS,FRBMAS,CRBMAS,
     $    SBMAS,LTRANS,RTRANS,LEAFNF,ROOTNF,PHSAGE,SI,FRFPRO,ISAGE,AGE,
     $    FERTNR)
C
        IF (AGE.NE.ROTATN) GO TO 15
           CALL HARV
           PHSAGE=0.0
          IF (SHBURN.NE.0) CALL SLASHB(SBURNT,SOILC,SOILN,ROTNUM,NSBHAR)
           GO TO 20
C
   15   CALL LITTER(LBMAS,ROTNUM,FRBMAS,RTRANS,LTRANS,SOILC,SOILN,
     $                  LEAFNF,ROOTNF)
C
   20   CONTINUE
C
        CALL ANNUAL(SOILN,NINPUT,NOUTPT,ROTNUM,RAINNR,OUTNR)
C
        AGE=AGE+1
C
        IF(AGE.EQ.FTRIG) FERFAC=0.0
        IF(AGE.EQ.PBTRIG) PBFAC=0.0
C                                         accelerate allowable growth
        PHSAGE=PHSAGE+FERFAC+PBFAC+1.0
C
   30 CONTINUE
C
      WRITE(*,31)
   31 FORMAT(/1X,'IF YOU WANT A PRINTED COPY OF INPUTS AND RESULTS,',  
     $/1X,'PRESS CONTROL-P AT THIS TIME TO START PRINTER ECHO.',/1X,
     $'OTHERWISE YOU WILL NEED TO STOP THE SCROLLING AT SEVERAL POINTS',
     $/1X,'TO PREVENT RESULTS FROM DISAPPEARING OFF THE TOP OF YOUR', 
     $/1X,'SCREEN.  THIS IS DONE BY PRESSING CONTROL-S.',/1X,
     $'SCROLLING CAN BE RESTARTED BY HITTING THE SPACE BAR.'/)
      PAUSE
C
      CALL ECHO
      CALL REPORT
C
      WRITE(*,32)
   32 FORMAT(//1X,'IF PRINTER ECHO IS ON, TURN IT OFF NOW BY PRESSING',
     $/1X,'CONTROL-P AGAIN')
C
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE AVAILN(SOILC,SOILN,ROTNUM,LBMAS,BBMAS,FRBMAS,CRBMAS,
     $  SBMAS,LTRANS,RTRANS,LEAFNF,ROOTNF,PHSAGE,SI,FRFPRO,ISAGE,AGE,
     $  FERTNR)
C
      REAL SOILC,SOILN(6),LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,CNRATO,
     $LTRANS,RTRANS,LEAFNF,ROOTNF,PHSAGE,NAVAIL,NREQ,FRFPRO,TRANS,LBN,
     $BBN,FRBN,CRBN,SBN,MINRL,NAMT,XPONNT,FERTNR(6)
C
      INTEGER SI,ROTNUM,ISAGE,AGE
C                                              add fertilizer N maybe
      NAMT=0.0
      IF (AGE .EQ. FERAGE .AND. FERATE .NE. 0) NAMT=FERTNR(ROTNUM)
C                                              determine available N
      CNRATO=SOILC/SOILN(ROTNUM)
      MINRL=SOILN(ROTNUM)*0.012*(2.7-ALOG(0.2*CNRATO)) 
      NAVAIL=MINRL+NAMT
C                                            set initial biomass amts
    5 IF (AGE .GT. 1) GO TO 10
        LBN=0.0
        BBN=0.0
        FRBN=0.0
        CRBN=0.0
        SBN=0.0
C
   10 IF (SI .NE. 45) GO TO 50
C                                        stem biomass chapman/richards
          XPONNT=1-EXP(-0.088*PHSAGE)
           IF (XPONNT .LE. 0) XPONNT=0.0001
           SBMAS=102000.0*(XPONNT**4.7) 
      IF (PHSAGE .GT. 30) GO TO 20
        LBMAS=200.*PHSAGE
        GO TO 30
C
   20   LBMAS=6000.
C
   30   IF (PHSAGE .GT.60) GO TO 40
          BBMAS=250.0*PHSAGE
          GO TO 45
C
   40   BBMAS=15000.0
C
   45   CRBMAS=0.2*SBMAS
        FRBMAS=(FRFPRO/100.0)*LBMAS
        GO TO 250
C
   50 IF (SI .NE. 55) GO TO 100
          XPONNT=1-EXP(-0.120*PHSAGE)
           IF (XPONNT .LE. 0) XPONNT=0.0001
           SBMAS=122400.0*(XPONNT**6.2) 
        IF (PHSAGE .GT. 25) GO TO 60
          LBMAS=280.*PHSAGE
          GO TO 70
C
   60   LBMAS=7000.
C
   70   IF (PHSAGE .GT. 60) GO TO 80
          BBMAS=333.33*PHSAGE
          GO TO 85
C
   80   BBMAS=20000.0
C
   85   CRBMAS=0.2*SBMAS
        FRBMAS=(FRFPRO/100.0)*LBMAS
        GO TO 250
C
  100 IF (SI .NE. 65) GO TO 150
          XPONNT=1-EXP(-0.1253*PHSAGE)
           IF (XPONNT .LE. 0) XPONNT=0.0001
           SBMAS=171788.0*(XPONNT**5.3) 
        IF (PHSAGE .GT. 25) GO TO 110
          LBMAS=320.*PHSAGE
          GO TO 120
C
  110   LBMAS=8500.
C
  120   IF (PHSAGE .GT. 60) GO TO 130
          BBMAS=416.66*PHSAGE
          GO TO 140
C
  130   BBMAS=25000.0
C
  140   CRBMAS=0.2*SBMAS
        FBRMAS=(FRFPRO/100.0)*LBMAS
        GO TO 250
C
  150 CONTINUE
      XPONNT=1-EXP(-0.114*PHSAGE)
           IF (XPONNT .LE. 0) XPONNT=0.0001
           SBMAS=244800.0*(XPONNT**4.3) 
        IF (PHSAGE .GT. 20) GO TO 160
          LBMAS=450.*PHSAGE
           GO TO 170
C
  160   LBMAS=9000.
C 
  170   IF (PHSAGE .GT. 60) GO TO 180
          BBMAS=500.0*PHSAGE
          GO TO 190
C
  180   BBMAS=30000.0
C
  190   CRBMAS=0.2*SBMAS
        FRBMAS=(FRFPRO/100.0)*LBMAS
C
C
  250 CONTINUE
C                                  if first year, cannot calculate NREQ
      IF (ROTNUM .NE. 1 .OR. AGE .NE. ISAGE) GO TO 255
        TRANS=0.0
        NREQ=0.0
        GOTO 260
C
C                                    calculate retranslocation, N needs
  255 CONTINUE
      TRANS=(LTRANS/100.0)*(LEAFNF/100.0)*LBN*0.50
     $      +(RTRANS/100.0)*(ROOTNF/100.0)*FRBN
C
      NREQ=(LBMAS-LBN)*(LEAFNF/100.0)+(BBMAS-BBN)*0.0033+(FRBMAS-FRBN)
     $     *(ROOTNF/100.0)+((CRBMAS-CRBN)+(SBMAS-SBN))*0.001+0.5*LBN
     $     *(LEAFNF/100.0)+FRBN*(ROOTNF/100.0)-TRANS
C
C                                    see if enough N is available
  260 IF (NAVAIL .LT. NREQ) GO TO 400
C
C                                    deduct N uptake
      SOILN(ROTNUM)=SOILN(ROTNUM)-NREQ
      GO TO 500
C
C                                    reduce growth and try again
  400 CONTINUE
      PHSAGE=PHSAGE-0.20
      IF (PHSAGE .LE. 0) PHSAGE=0.0
      GOTO 5
C
C                                   update previous biomass and return
  500 CONTINUE
        LBN=LBMAS
        BBN=BBMAS
        FRBN=FRBMAS
        CRBN=CRBMAS
        SBN=SBMAS
      RETURN
      END
C
C
C**********************************************************************
C
C
      SUBROUTINE ZERO
C
      REAL SOILC,SOILN(6),NREMOV(6),NREML(6),NREMB(6),
     $NREMS(6),NREMCR(6),NPBHAR(6),NSBHAR(6),RAINNR(6),FERTNR(6),
     $OUTNR(6),HLBMAS(6),HBBMAS(6),HSBMAS(6),HCRMAS(6),HTREM(6),
     $LEAFNF,ROOTNF,LTRANS,RTRANS,ISOILN,NINPUT,NOUTPT,
     $FRFPRO
C
      INTEGER ROTNUM,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,SHBURN,
     $SBURNT,HARVT,FERATE,FREQBN,NUM
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,
     $NOUTPT,FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,
     $SHBURN,SBURNT,HARVT,FERATE,FREQBN,NUM
C
      COMMON/OUT/LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILN,NREMOV,
     $NREMB,NREML,NREMS,NREMCR,NPBHAR,NSBHAR,RAINNR,FERTNR,
     $OUTNR,HLBMAS,HBBMAS,HSBMAS,HCRMAS,HTREM,ROTNUM
C
      DO 10 I=1,6
C
        SOILN(I)=0.0
        NREMOV(I)=0.0
        NREMB(I)=0.0
        NREML(I)=0.0
        NREMS(I)=0.0
        NREMCR(I)=0.0
        NPBHAR(I)=0.0
        NSBHAR(I)=0.0
        RAINNR(I)=0.0
        FERTNR(I)=0.0
        OUTNR(I)=0.0
        HLBMAS(I)=0.0
        HBBMAS(I)=0.0
        HSBMAS(I)=0.0
        HCRMAS(I)=0.0
        HTREM(I)=0.0
C
   10 CONTINUE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE INPUT
C
      REAL LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,NOUTPT,
     $FRFPRO
C
      INTEGER AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,SHBURN,SBURNT,
     $HARVT,FERATE,FREQBN,NUM
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,NOUTPT,
     $FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,SHBURN,SBURNT,
     $HARVT,FERATE,FREQBN,NUM
C
      WRITE(*,900)
  900 FORMAT(///1X,'ENTER THE INITIAL STAND AGE IN YEARS --->')
      READ(*,905)AGE
  905 FORMAT(I5)
C
      WRITE(*,1000)
 1000 FORMAT(///1X,'ENTER THE SITE INDEX WITH A BASE AGE OF 25',/1X,
     $'(CHOICES ARE: 45, 55, 65, AND 75) --->')
      READ(*,905)SI
C
      WRITE(*,1005)
 1005 FORMAT(///1X,'ENTER THE DESIRED ROTATION LENGTH IN YEARS --->')
      READ(*,905)ROTATN
C
      IF (ROTATN .GT. 70) WRITE(*,1006)
        GO TO 1008
 1006 FORMAT(///1X,'WARNING: MODEL NOT VALID FOR ROTATIONS GREATER THAN
     $70')
C
 1008 WRITE(*,1010)
 1010 FORMAT(///1X,'ENTER THE NUMBER OF ROTATIONS (MAX OF 5) THAT YOU'
     $,/1X,'WOULD LIKE TO SIMULATE --->')
      READ(*,905)NUM
C
 1015 IF (NUM .GT. 5) GO TO 1019
        GO TO 1025
 1019 WRITE(*,1020)
 1020 FORMAT(///1X,'YOU ENTERED MORE THAN 5 ROTATIONS;'/1X,'RE-ENTER A'
     $,' NUMBER LESS THAN 6 --->')
      READ(*,905)NUM
      GO TO 1015
C
 1025 WRITE(*,1030)
 1030 FORMAT(///1X,'ENTER THE STAND AGE AT WHICH YOU WANT TO',/,1X,
     $'FERTILIZE. IF YOU DO NOT WANT TO FERTILIZE, ENTER 0 --->')
      READ(*,905)FERAGE
C
      WRITE(*,1040)
 1040 FORMAT(///1X,'ENTER THE FERTILIZER RATE: 100,200,OR 300 KG/HA.',/,
     $1X,'IF YOU ARE NOT GOING TO FERTILIZE, ENTER 0 --->')
      READ(*,905)FERATE
C
      WRITE(*,1055)
 1055 FORMAT(///1X,'ENTER THE AGE WHEN YOU FIRST WANT TO PRESCRIBE BURN.
     $',/,1X,'IF YOU DO NOT WANT TO PRESCRIBE BURN, ENTER 0 --->')
      READ(*,905)PBBURN
C
      WRITE(*,1057)
 1057 FORMAT(///1X,'ENTER THE FREQUENCY AT WHICH YOU WANT TO PRESCRIBE'
     $,/,1X,'BURN. IF YOU DO NOT WANT TO PRESCRIBE BURN ENTER 0 --->')
      READ(*,905)FREQBN
C
      WRITE(*,1058)
 1058 FORMAT(///1X,'HOW HOT WILL YOUR PRESCRIBED BURN BE? ENTER 2 FOR',
     $/,1X,'HOT, 1 FOR WARM. IF YOU ARE NOT GOING TO PRESCRIBE BURN,'
     $,/,1X,'ENTER 0 --->')
      READ(*,905)BURNTP
C
      WRITE(*,1060)
 1060 FORMAT(///1X,'TYPE OF HARVEST METHOD. ENTER 1 FOR WHOLE TREE,',/,
     $1X,'2 FOR STEM ONLY --->')
      READ(*,905)HARVT
C
      WRITE(*,1075)
 1075 FORMAT(///1X,'DO YOU WANT TO BROADCAST BURN THE SLASH AFTER'
     $,/,1X,'HARVEST? ENTER 1 FOR YES, 0 FOR NO --->')
      READ(*,905)SHBURN
C
      WRITE(*,1085)
 1085 FORMAT(///1X,'HOW HOT WILL YOUR BROADCAST BURN BE? ENTER 2 FOR'
     $,/,1X,'HOT, 1 FOR WARM. IF NOT GOING TO BROADCAST BURN,',/,1X,
     $'ENTER 0 --->')
      READ(*,905)SBURNT
C
      WRITE(*,1095)
 1095 FORMAT(///1X,'ENTER THE PERCENT OF NITROGEN REABSORBED FROM THE',/
     $,1X,'LEAVES PRIOR TO ABSCISSION. YOU MUST INCLUDE A DECIMAL ',
     $'POINT  --->')
      READ(*,1100)LTRANS
 1100 FORMAT(F6.2)
C
      WRITE(*,1105)
 1105 FORMAT(///1X,'ENTER THE PERCENT OF NITROGEN REABSORBED FROM THE'
     $,/,1X,'FINE ROOTS PRIOR TO SENESCENCE. YOU MUST INCLUDE A ',
     $'DECIMAL POINT  --->')
      READ(*,1100)RTRANS
C
      WRITE(*,1112)
 1112 FORMAT(///1X,'ENTER THE WEIGHT RATIO OF FINE ROOTS TO FOLIAGE,'
     $,/,1X,'EXPRESSED AS A PERCENTAGE. YOU MUST INCLUDE A ',
     $'DECIMAL POINT  --->')
      READ(*,1100)FRFPRO
C
      WRITE(*,1120)
 1120 FORMAT(///1X,'ENTER THE TOTAL SOIL CARBON POOL IN KG/HA --->'
     $)
      READ(*,1122)SOILC
 1122 FORMAT(F8.0)
C
      WRITE(*,1125)
 1125 FORMAT(///1X,'INITIALIZE THE TOTAL NITROGEN POOL IN KG/HA --->')
      READ(*,1122)ISOILN
C
      WRITE(*,1135)
 1135 FORMAT(///1X,'ENTER THE PERCENT WEIGHT CONTENT OF NITROGEN',/,1X,
     $'IN LEAVES. YOU MUST INCLUDE A DECIMAL POINT  --->')
      READ(*,1140)LEAFNF
 1140 FORMAT(F4.2)
C
      WRITE(*,1145)
 1145 FORMAT(///1X,'ENTER THE PERCENT WEIGHT CONTENT OF NITROGEN',/,1X,
     $'IN FINE ROOTS. YOU MUST INCLUDE A DECIMAL POINT  --->')
      READ(*,1140)ROOTNF
C
      WRITE(*,1155)
 1155 FORMAT(///1X,'ENTER THE ANNUAL INPUT OF NITROGEN FROM ATMOSPHERIC
     $',/,1X,'SOURCES AND FROM BIOLOGICAL N FIXATION (KG/HA) --->')
      READ(*,1122)NINPUT
C
      WRITE(*,1165)
 1165 FORMAT(///1X,'ENTER THE ANNUAL OUTPUT OF NITROGEN FROM LEACHING',/
     $,1X,'BEYOND THE ROOTING ZONE (KG/HA) --->')
      READ(*,1122)NOUTPT
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE ECHO
C
      REAL LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,NOUTPT,
     $FRFPRO
C
      INTEGER AGE,SI,ROTATN,FINISH,FERAGE,PBBURN,BURNTP,SHBURN,SBURNT,
     $HARVT,FERATE,FREQBN
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,
     $NOUTPT,FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,SHBURN,
     $SBURNT,HARVT,FERATE,FREQBN,NUM
C
      WRITE(*,2000)
 2000 FORMAT(1H1/1X,'USER-CONTROLLED SIMULATION PARAMETERS')
      WRITE(*,2005)
 2005 FORMAT(1X,'-------------------------------------')
C
      FINISH=ROTATN*NUM-AGE
      WRITE(*,2010)FINISH
 2010 FORMAT(/1X,'SIMULATION PERIOD:',I5,' YEARS')
C
      WRITE(*,2011)NUM
 2011 FORMAT(/1X,'NUMBER OF ROTATIONS TO BE SIMULATED:  ',I1)
C
      WRITE(*,2015)AGE
 2015 FORMAT(/1X,'INITIAL STAND AGE:',I5,' YEARS')
C
      WRITE(*,2020)ROTATN
 2020 FORMAT(/1X,'ROTATION LENGTH:  ',I5,' YEARS')
C
      WRITE(*,2021)SI
 2021 FORMAT(/1X,'SITE INDEX:  ',I3)
C
      WRITE(*,2025)SOILC
 2025 FORMAT(/1X,'SOIL CARBON POOL:    ',F8.0,' KG/HA')
C
      WRITE(*,2030)ISOILN
 2030 FORMAT(/1X,'INITIAL SOIL NITROGEN POOL:  ',F8.0,' KG/HA')
C
      WRITE(*,2035)LEAFNF
 2035 FORMAT(/1X,'PERCENT N IN FOLIAGE:   ',F5.2,' %')
C
      WRITE(*,2040)ROOTNF
 2040 FORMAT(/1X,'PERCENT N IN FINE ROOTS:',F5.2,' %')
C
      WRITE(*,2045)
 2045 FORMAT(/1X,'PERCENT N REABSORBED')
      WRITE(*,2050)LTRANS
 2050 FORMAT(1X,'PRIOR TO LEAF ABSCISSION:           ',F5.2,' %')
C
      WRITE(*,2055)
 2055 FORMAT(/1X,'PERCENT N REABSORBED')
      WRITE(*,2060)RTRANS
 2060 FORMAT(1X,'PRIOR TO SENESCENCE OF FINE ROOTS:  ',F5.2,' %')
C
      PAUSE
C
      WRITE(*,2063)FRFPRO
 2063 FORMAT(/1X,'PERCENT OF FINE ROOTS TO FOLIAGE:  ',F6.2,' %')
C
      WRITE(*,2065)NINPUT
 2065 FORMAT(/1X,'ANNUAL N INPUT: ',F5.0,' KG/HA')
C
      WRITE(*,2070)NOUTPT
 2070 FORMAT(/1X,'ANNUAL N OUTPUT:',F5.0,' KG/HA')
C
      IF (FERAGE .EQ. 0) GO TO 2076
      WRITE(*,2075)
 2075 FORMAT(/1X,'N FERTILIZATION?  YES')
      GO TO 2079
 2076 WRITE(*,2077)
 2077 FORMAT(/1X,'N FERTILIZATION?  NO')
C
 2079 WRITE(*,2080)FERATE
 2080 FORMAT(/1X,'N FERTILIZATION RATE:',I5,' KG/HA')
C
      WRITE(*,2082)FERAGE
 2082 FORMAT(/1X,'STAND AGE WHEN FERTILIZED:',I3,' YEARS')
C
      IF (PBBURN .NE. 0) GO TO 2087
      WRITE(*,2085)
 2085 FORMAT(/1X,'PRESCRIBED BURNING?  NO')
      GO TO 2089
 2087 WRITE(*,2088)
 2088 FORMAT(/1X,'PRESCRIBED BURNING?  YES')
C
 2089 WRITE(*,2090)
 2090 FORMAT(/1X,'INITIAL STAND AGE WHEN')
      WRITE(*,2095)PBBURN
 2095 FORMAT(1X,'FIRST PRESCRIBE BURN:',I3,' YEARS')
C
      WRITE(*,2100)FREQBN
 2100 FORMAT(/1X,'FREQUENCY OF PRESCRIBED BURNS: EVERY',I3,' YEARS')
C
      IF (BURNTP .EQ. 1) GO TO 2103
      IF (BURNTP .EQ. 0) GO TO 2109
      WRITE(*,2101)
 2101 FORMAT(/1X,'RELATIVE TEMPERATURE OF PRESCRIBED BURNS: HOT')
      GO TO 2109
 2103 WRITE(*,2105)
 2105 FORMAT(/1X,'RELATIVE TEMPERATURE OF PRESCRIBED BURNS: WARM')
      GO TO 2109
C
 2109 IF (SHBURN .EQ. 0) GO TO 2116
      WRITE(*,2115)
 2115 FORMAT(/1X,'SLASH BURNING?  YES')
      GO TO 2118
 2116 WRITE(*,2117)
 2117 FORMAT(/1X,'SLASH BURNING?  NO')
C
 2118 IF (SBURNT .EQ. 1) GO TO 2124
      IF (SBURNT .EQ. 0) GO TO 2127
      WRITE(*,2120)
 2120 FORMAT(/1X,'RELATIVE TEMPERATURE OF SLASH BURNS:  HOT')
      GO TO 2127
 2124 WRITE(*,2125)
 2125 FORMAT(/1X,'RELATIVE TEMPERATURE OF SLASH BURNS:  WARM')
C
 2127 IF (HARVT .EQ. 1) GO TO 2131
      WRITE(*,2130)
 2130 FORMAT(/1X,'HARVEST METHOD:  STEM ONLY')
      GO TO 2133
 2131 WRITE(*,2132)
 2132 FORMAT(/1X,'HARVEST METHOD:  WHOLE TREE')
C
 2133 CONTINUE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE ANNUAL(SOILN,NINPUT,NOUTPT,ROTNUM,RAINNR,OUTNR)
C
      REAL SOILN(6),NINPUT,NOUTPT,RAINNR(6),OUTNR(6)
C
      INTEGER ROTNUM
C
      RAINNR(ROTNUM)=RAINNR(ROTNUM)+NINPUT
      OUTNR(ROTNUM)=OUTNR(ROTNUM)+NOUTPT
C
      SOILN(ROTNUM)=SOILN(ROTNUM)+NINPUT-NOUTPT
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE LITTER(LBMAS,ROTNUM,FRBMAS,RTRANS,LTRANS,SOILC,SOILN,
     $                  LEAFNF,ROOTNF)
C
      REAL LBMAS,FRBMAS,SOILC,SOILN(6),RTRANS,LTRANS,LEAFNF,ROOTNF
C
      INTEGER ROTNUM
C
      SOILN(ROTNUM)=SOILN(ROTNUM)+(0.50*LBMAS*(LEAFNF/100.))*
     $              (1.-(LTRANS/100.))+(FRBMAS*(ROOTNF/100.))*
     $              (1.-(RTRANS/100.))
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE FERT(SOILN,FERATE,AGE,FTRIG,ROTNUM,FERFAC,FERTNR)
C
      REAL SOILN(6),FERTNR(6),FERFAC
C
      INTEGER FERATE,AGE,ROTNUM,FTRIG
C
      IF (FERATE .NE. 100) GO TO 10
        FERTNR(ROTNUM)=FERTNR(ROTNUM)+100.0
        SOILN(ROTNUM)=SOILN(ROTNUM)+100.0
        FERFAC=0.20
        FTRIG=AGE+3
C
        GO TO 30
C
   10 CONTINUE
C
      IF (FERATE .NE. 200) GO TO 20
        FERTNR(ROTNUM)=FERTNR(ROTNUM)+200.0
        SOILN(ROTNUM)=SOILN(ROTNUM)+200.0
        FERFAC=0.25
        FTRIG=AGE+4
C
        GO TO 30
C
   20 CONTINUE
C
      FERATE=300                                
      FERTNR(ROTNUM)=FERTNR(ROTNUM)+300.
      SOILN(ROTNUM)=SOILN(ROTNUM)+300.
      FERFAC=0.25
      FTRIG=AGE+5
C
   30 CONTINUE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE PBURN(AGE,BURNTP,SOILC,SOILN,ROTNUM,PBTRIG,PBFAC,
     $                 NPBHAR)
C
      REAL SOILC,SOILN(6),PBFAC,NPBHAR(6),CLOSS
C
      INTEGER AGE,BURNTP,ROTNUM,PBTRIG
C                                           N loss, warm
      IF (BURNTP .NE. 1) GO TO 10
        SOILN(ROTNUM)=SOILN(ROTNUM)-20.0
        NPBHAR(ROTNUM)=NPBHAR(ROTNUM)+20.0
        PBTRIG=AGE+2
        PBFAC=0.25
C
        GO TO 20
C
   10 CONTINUE
C                                          N loss, hot
      SOILN(ROTNUM)=SOILN(ROTNUM)-40.0
      NPBHAR(ROTNUM)=NPBHAR(ROTNUM)+40.0
      PBTRIG=AGE+3
      PBFAC=0.25
C
   20 CONTINUE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE SLASHB(SBURNT,SOILC,SOILN,ROTNUM,NSBHAR)
C
      REAL SOILC,SOILN(6),NSBHAR(6),CLOSS
C
      INTEGER SBURNT,ROTNUM
C                                          N loss, warm
      IF (SBURNT .NE. 1) GO TO 10
        SOILN(ROTNUM)=SOILN(ROTNUM)-75.0
        NSBHAR(ROTNUM)=NSBHAR(ROTNUM)+75.0
        GO TO 20
C
   10 CONTINUE
C                                          N loss, hot
      SOILN(ROTNUM)=SOILN(ROTNUM)-150.0
      NSBHAR(ROTNUM)=NSBHAR(ROTNUM)+150.0
C
   20 CONTINUE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE HARV
C
      REAL HLBMAS(6),HBBMAS(6),HSBMAS(6),HCRMAS(6),HTREM(6),NREML(6),
     $NREMCR(6),NREMS(6),NREMB(6),NREMOV(6),SOILC,SOILN(6),LBMAS,
     $CRBMAS,SBMAS,BBMAS,FRBMAS,ROOTNF,LEAFNF,NPBHAR(6),NSBHAR(6),
     $RAINNR(6),FERTNR(6),NETDNR,OUTNR(6),LTRANS,RTRANS,ISOILN,
     $NINPUT,NOUTPT,FRFPRO
C
      INTEGER ROTNUM,HARVT,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,SHBURN,
     $SBURNT,FERATE,FREQBN,NUM
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,
     $NOUTPT,FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,
     $SHBURN,SBURNT,HARVT,FERATE,FREQBN,NUM
C
      COMMON/OUT/LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILN,NREMOV,
     $NREMB,NREML,NREMS,NREMCR,NPBHAR,NSBHAR,RAINNR,FERTNR,
     $OUTNR,HLBMAS,HBBMAS,HSBMAS,HCRMAS,HTREM,ROTNUM
C
      IF (HARVT .NE. 1) GO TO 20
C
      HLBMAS(ROTNUM)=LBMAS
      HBBMAS(ROTNUM)=BBMAS
      HSBMAS(ROTNUM)=SBMAS
      HCRMAS(ROTNUM)=CRBMAS
C
      HTREM(ROTNUM)=LBMAS+BBMAS+SBMAS+CRBMAS
C
      NREML(ROTNUM)=LBMAS*(LEAFNF/100.)
      NREMCR(ROTNUM)=CRBMAS*0.001
      NREMS(ROTNUM)=SBMAS*0.001
      NREMB(ROTNUM)=BBMAS*0.0033
C
      NREMOV(ROTNUM)=NREML(ROTNUM)+NREMCR(ROTNUM)+NREMS(ROTNUM)+
     $               NREMB(ROTNUM)
C
      SOILN(ROTNUM)=SOILN(ROTNUM)+FRBMAS*(ROOTNF/100.0)
C
      GO TO 30
C
   20 HSBMAS(ROTNUM)=SBMAS
C
      HTREM(ROTNUM)=HSBMAS(ROTNUM)
C
      NREMS(ROTNUM)=SBMAS*0.001
C
      NREMOV(ROTNUM)=NREMS(ROTNUM)
C
      SOILN(ROTNUM)=SOILN(ROTNUM)+LBMAS*(LEAFNF/100.)+CRBMAS*0.001+
     $              BBMAS*0.0033+FRBMAS*(ROOTNF/100.)
C
   30 SOILN(ROTNUM+1)=SOILN(ROTNUM)
C
      ROTNUM=ROTNUM+1
C
      AGE=0
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE REPORT
C
      REAL LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILC,SOILN(6),
     $NREMOV(6),NREMB(6),NREML(6),NREMS(6),NREMCR(6),NPBHAR(6),
     $NSBHAR(6),RAINNR(6),FERTNR(6),NETDNR,OUTNR(6),HLBMAS(6),
     $HBBMAS(6),HSBMAS(6),HCRMAS(6),HTREM(6),NREMSL,NRMSCR,NREMSS,
     $NREMSB,NPBURN,NSBURN,RAINNS,FERTNS,NETDNS,OUTNS,TLREM,TBREM,
     $TSREM,TCRREM,TREM,TBMNRS,ENTRNR,CNRATO,NREMSI,NRUBS,
     $NRUBR,LEAFNF,ROOTNF,LTRANS,RTRANS,ISOILN,NINPUT,
     $NOUTPT,FRFPRO
C
      INTEGER ISAGE,ROTNUM,SIMTIM,ROTATN,HARVT,NUM,AGE,SI,FERAGE,
     $PBBURN,BURNTP,SHBURN,SBURNT,FERATE,FREQBN,BEGIN
C
      COMMON/IN/LTRANS,RTRANS,SOILC,ISOILN,LEAFNF,ROOTNF,NINPUT,
     $NOUTPT,FRFPRO,AGE,SI,ROTATN,FERAGE,PBBURN,BURNTP,
     $SHBURN,SBURNT,HARVT,FERATE,FREQBN,NUM
C
      COMMON/OUT/LBMAS,BBMAS,FRBMAS,CRBMAS,SBMAS,SOILN,NREMOV,
     $NREMB,NREML,NREMS,NREMCR,NPBHAR,NSBHAR,RAINNR,FERTNR,
     $OUTNR,HLBMAS,HBBMAS,HSBMAS,HCRMAS,HTREM,ROTNUM
C
      COMMON/REPOT/ISAGE
C
      NREMSL=0.0
      NRMSCR=0.0
      NREMSS=0.0
      NREMSB=0.0
      NPBURN=0.0
      NSBURN=0.0
      RAINNS=0.0
      FERTNS=0.0
      NETDNS=0.0
      OUTNS=0.0
      TLREM=0.0
      TBREM=0.0
      TSREM=0.0
      TCRREM=0.0
      NREMSI=0.0
C
      DO 100  I=1,NUM
C
        NREMSL=NREMSL+NREML(I)
        NRMSCR=NRMSCR+NREMCR(I)
        NREMSS=NREMSS+NREMS(I)
        NREMSB=NREMSB+NREMB(I)
C
        NPBURN=NPBURN+NPBHAR(I)
C
        NSBURN=NSBURN+NSBHAR(I)
C
        RAINNS=RAINNS+RAINNR(I)
C
        FERTNS=FERTNS+FERTNR(I)
C
        OUTNS=OUTNS+OUTNR(I)
C
        TLREM=TLREM+HLBMAS(I)
        TBREM=TBREM+HBBMAS(I)
        TSREM=TSREM+HSBMAS(I)
        TCRREM=TCRREM+HCRMAS(I)
C
        NREMSI=NREMOV(I)+NREMSI
C
  100 CONTINUE
C
      TBMNRS=NREMSL+NRMSCR+NREMSS+NREMSB
C
      TREM=TLREM+TBREM+TSREM+TCRREM
C
      BEGIN=ISAGE
C
      DO 200 I=1,NUM
C
        IF (I .NE. 1) BEGIN=0
C
        ENTRNR=RAINNR(I)+FERTNR(I)
C
        WRITE(*,2000)
 2000   FORMAT(1H1,5X,'SUMMARY OF NITROGEN BUDGET OF SITE AND BIOMASS YI
     $ELDS BY ROTATION')
        WRITE(*,2010)
 2010   FORMAT(6X,'-----------------------------------------------------
     $------------')
C
        SIMTIM=I*ROTATN-ISAGE
        WRITE(*,2020)SIMTIM
 2020   FORMAT(/1X,'SIMULATION YEAR:   ',I3)
C
        WRITE(*,2030)
 2030   FORMAT(/1X,'INITIAL AGE OF')
        WRITE(*,2040)BEGIN
 2040   FORMAT(1X,'STAND:             ',I3)
C
        WRITE(*,2050)I
 2050   FORMAT(/1X,'ROTATION NUMBER:     ',I1)
C
        WRITE(*,2060)
 2060   FORMAT(/1X,'INPUTS OF NITROGEN TO SITE (KG/HA)     OUTPUTS OF NI
     $TROGEN FROM SITE (KG/HA)')
        WRITE(*,2070)
 2070   FORMAT(1X,'----------------------------------     --------------
     $-----------------------')
C
        WRITE(*,2080)FERTNR(I),NSBHAR(I)
 2080   FORMAT(/1X,'FERTILIZATION:  ',F8.0,18X,'SLASH BURNING:   ',F8.0)
C
        WRITE(*,2090)RAINNR(I),NPBHAR(I)
 2090   FORMAT(/1X,'PRECIPITATION:  ',F8.0,18X,'PRESCRIBED',/43X,'BURNIN
     $G:         ',F8.0)
C
        WRITE(*,2100)OUTNR(I)
 2100   FORMAT(/17X,'-------',/43X,'LEACHING:        ',F8.0)
C
        WRITE(*,2110)ENTRNR
 2110   FORMAT(/9X,'TOTAL: ',F9.0,18X,'LOSSES FROM BIOMASS REMOVALS')
C
        WRITE(*,2120)NREMS(I)
 2120   FORMAT(/46X,'STEMS:          ',F8.2)
C
        WRITE(*,2130)NREMCR(I)
 2130   FORMAT(/46X,'COARSE ROOTS:   ',F8.2)
C
        WRITE(*,2140)NREML(I)
 2140   FORMAT(/46X,'FOLIAGE:        ',F8.2)
C
        WRITE(*,2150)NREMB(I)
 2150   FORMAT(/46X,'BRANCHES:       ',F8.2)
C
        WRITE(*,2160)NREMOV(I)
 2160   FORMAT(/62X,'--------',//53X,'TOTAL: ',F10.2)
C
        NETDNR=ENTRNR-NREMOV(I)-NSBHAR(I)-NPBHAR(I)-OUTNR(I)
        NETDNS=NETDNS+NETDNR
C
        WRITE(*,2170)NETDNR
 2170   FORMAT(/1X,'NET CHANGE IN TOTAL NITROGEN OF SITE (KG/HA):
     $       ',F8.0)
C
        IF (I .LE. 1) GO TO 2184
          SOILN(I)=SOILN(I-1)+NETDNR
          GO TO 2185
 2184   SOILN(1)=ISOILN+NETDNR
C
 2185   WRITE(*,2190)SOILN(I)
 2190   FORMAT(/1X,'SOIL NITROGEN POOL AT END OF ROTATION (KG/HA):    ',
     $F10.0)
        CNRATO=SOILC/SOILN(I)
        WRITE(*,2200)CNRATO
 2200   FORMAT(/1X,'CARBON:NITROGEN RATIO AT END OF ROTATION:
     $            ',F7.0)
C
        WRITE(*,2210)
 2210   FORMAT(/1X,'BIOMASS YIELDS (KG/HA)',/1X,'----------------------'
     $)
C
        WRITE(*,2220)HSBMAS(I)
 2220   FORMAT(/1X,'STEMS:         ',F8.0)
C
        WRITE(*,2230)HCRMAS(I)
 2230   FORMAT(/1X,'COARSE ROOTS:  ',F8.0)
C
        WRITE(*,2240)HLBMAS(I)
 2240   FORMAT(/1X,'FOLIAGE:       ',F8.0)
C
        WRITE(*,2250)HBBMAS(I)
 2250   FORMAT(/1X,'BRANCHES:      ',F8.0)
C
        WRITE(*,2260)HTREM(I)
 2260   FORMAT(/16X,'--------',/8X,'TOTAL: ',F10.0)
C
        IF (NREMOV(I) .NE. 0.0) GO TO 2263
          NRUBR=0.0
          GO TO 2264
C
 2263   NRUBR=HTREM(I)/NREMOV(I)
 2264   WRITE(*,2265)NRUBR
 2265   FORMAT(//1X,'BIOMASS YIELD PER UNIT OF NITROGEN REMOVED:  ',F9.0
     $)
C
        PAUSE
C
  200 CONTINUE
C
      WRITE(*,2270)
 2270 FORMAT(1H1)
C
      WRITE(*,2280)
 2280 FORMAT(5X,'SUMMARY OF NITROGEN BUDGET AND BIOMASS YIELDS FOR ENTIR
     $E SIMULATION',/5X,'-----------------------------------------------
     $--------------------')
C
      WRITE(*,2290)
 2290 FORMAT(/1X,'INPUTS OF NITROGEN TO SITE (KG/HA)     OUTPUTS OF NI
     $TROGEN FROM SITE (KG/HA)')
      WRITE(*,2300)
 2300 FORMAT(1X,'----------------------------------     --------------
     $-----------------------')
C
      WRITE(*,2310)FERTNS,NSBURN
 2310 FORMAT(/1X,'FERTILIZATION:  ',F9.0,17X,'SLASH BURNING:   ',F9.0)
C
      WRITE(*,2320)RAINNS,NPBURN
 2320 FORMAT(/1X,'PRECIPITATION:  ',F9.0,17X,'PRESCRIBED',/43X,'BURNING
     $:         ',F9.0)
C
      WRITE(*,2330)OUTNS
 2330 FORMAT(/17X,'--------',/43X,'LEACHING:        ',F9.0)
C
      ENTRNR=RAINNS+FERTNS
      WRITE(*,2340)ENTRNR
 2340 FORMAT(/9X,'TOTAL: ',F10.0,17X,'LOSSES FROM BIOMASS REMOVALS')
C
      WRITE(*,2350)NREMSS
 2350 FORMAT(/46X,'STEMS:          ',F9.2)
C
      WRITE(*,2360)NRMSCR
 2360 FORMAT(/46X,'COARSE ROOTS:   ',F9.2)
C
      WRITE(*,2370)NREMSL
 2370 FORMAT(/46X,'FOLIAGE:        ',F9.2)
C
      WRITE(*,2380)NREMSB
 2380 FORMAT(/46X,'BRANCHES:       ',F9.2)
C
      WRITE(*,2390)NREMSI
 2390 FORMAT(/62X,'---------',//53X,'TOTAL: ',F11.2)
C
      WRITE(*,2400)NETDNS
 2400 FORMAT(//1X,'NET CHANGE IN TOTAL NITROGEN OF SITE (KG/HA):    ',
     $F11.0)
C
      WRITE(*,2420)SOILN(I)
 2420 FORMAT(/1X,'SOIL NITROGEN POOL AT END OF SIMULATION (KG/HA):    ',
     $F8.0)
C
      CNRATO=SOILC/SOILN(I)
      WRITE(*,2430)CNRATO
 2430 FORMAT(/1X,'CARBON:NITROGEN RATIO AT END OF SIMULATION:          '
     $,F7.0)
C
      WRITE(*,2440)
 2440 FORMAT(//1X,'BIOMASS YIELDS (KG/HA)',/1X,'----------------------')
C
      WRITE(*,2450)TSREM
 2450 FORMAT(/1X,'STEMS:         ',F9.0)
C
      WRITE(*,2460)TCRREM
 2460 FORMAT(/1X,'COARSE ROOTS:  ',F9.0)
C
      WRITE(*,2470)TLREM
 2470 FORMAT(/1X,'FOLIAGE:       ',F9.0)
C
      WRITE(*,2480)TBREM
 2480 FORMAT(/1X,'BRANCHES:      ',F9.0)
C
      WRITE(*,2490)TREM
 2490 FORMAT(/15X,'---------',/8X,'TOTAL:',F11.0)
C
      IF (NREMSI .NE. 0.0) GO TO 2495
        NRUBS=0.0
        GO TO 2497
C
 2495 NRUBS=TREM/NREMSI
 2497 WRITE(*,2500)NRUBS
 2500 FORMAT(//1X,'BIOMASS YIELD PER UNIT OF NITROGEN REMOVED:  ',F12.0)
C
      WRITE(*,2510)
 2510 FORMAT(1H1)
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE BANNER
C
C
      DO 10 I=1,2
        WRITE(*,1010)
 1010   FORMAT(1X,72(' '))
   10 CONTINUE
C
      WRITE(*,1015)
 1015 FORMAT(1X,'  FFFFFFFF  OOOOOOOO  RRRRRR    NNN   NN  UUU  UUU  ',
     $'TTTTTTTT  SSSSSSSS  ')
      WRITE(*,1020)
 1020 FORMAT(1X,'  FFFFFFFF  OOOOOOOO  RRRRRRRR  NNN   NN  UUU  UUU  ',
     $'TTTTTTTT  SSSSSSSS  ')
      WRITE(*,1025)
 1025 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NNNN  NN  UUU  UUU  ',
     $'   TT     SSS  SSS  ')
      WRITE(*,1030)
 1030 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NNNN  NN  UUU  UUU  ',
     $'   TT     SSS       ')
      WRITE(*,1035)
 1035 FORMAT(1X,'  FFFFFF    OOO  OOO  RRRRRRRR  NNNNN NN  UUU  UUU  ',
     $'   TT     SSS       ')
      WRITE(*,1040)
 1040 FORMAT(1X,'  FFFFFF    OOO  OOO  RRRRRR    NNNNNNNN  UUU  UUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1045)
 1045 FORMAT(1X,'  FFF       OOO  OOO  RRRRRRR   NN NNNNN  UUU  UUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1050)
 1050 FORMAT(1X,'  FFF       OOO  OOO  RRR RRRR  NN  NNNN  UUU  UUU  ',
     $'   TT          SSS  ')
      WRITE(*,1055)
 1055 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NN  NNNN  UUU  UUU  ',
     $'   TT     SSS  SSS  ')
      WRITE(*,1060)
 1060 FORMAT(1X,'  FFF       OOOOOOOO  RRR   RR  NN   NNN  UUUUUUUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1065)
 1065 FORMAT(1X,'  FFF       OOOOOOOO  RRR   RR  NN   NNN  UUUUUUUU  ',
     $'   TT     SSSSSSSS  ')
C
      WRITE(*,1070)
 1070 FORMAT(1X,72(' '))
C
      WRITE(*,1080)
 1080 FORMAT(/1X,'a FORest NUTrient cycling Simulator'/1X,'  ---    ---'
     $,'              -')
C
      DO 20 I=1,6
        WRITE(*,1010)
   20 CONTINUE
C
C
      PAUSE
C
      RETURN
      END
C
C
C***********************************************************************
C
C
      SUBROUTINE HEADER
C
      WRITE(*,1015)
 1015 FORMAT(1X,'  FFFFFFFF  OOOOOOOO  RRRRRR    NNN   NN  UUU  UUU  ',
     $'TTTTTTTT  SSSSSSSS  ')
      WRITE(*,1020)
 1020 FORMAT(1X,'  FFFFFFFF  OOOOOOOO  RRRRRRRR  NNN   NN  UUU  UUU  ',
     $'TTTTTTTT  SSSSSSSS  ')
      WRITE(*,1025)
 1025 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NNNN  NN  UUU  UUU  ',
     $'   TT     SSS  SSS  ')
      WRITE(*,1030)
 1030 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NNNN  NN  UUU  UUU  ',
     $'   TT     SSS       ')
      WRITE(*,1035)
 1035 FORMAT(1X,'  FFFFFF    OOO  OOO  RRRRRRRR  NNNNN NN  UUU  UUU  ',
     $'   TT     SSS       ')
      WRITE(*,1040)
 1040 FORMAT(1X,'  FFFFFF    OOO  OOO  RRRRRR    NNNNNNNN  UUU  UUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1045)
 1045 FORMAT(1X,'  FFF       OOO  OOO  RRRRRRR   NN NNNNN  UUU  UUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1050)
 1050 FORMAT(1X,'  FFF       OOO  OOO  RRR RRRR  NN  NNNN  UUU  UUU  ',
     $'   TT          SSS  ')
      WRITE(*,1055)
 1055 FORMAT(1X,'  FFF       OOO  OOO  RRR  RRR  NN  NNNN  UUU  UUU  ',
     $'   TT     SSS  SSS  ')
      WRITE(*,1060)
 1060 FORMAT(1X,'  FFF       OOOOOOOO  RRR   RR  NN   NNN  UUUUUUUU  ',
     $'   TT     SSSSSSSS  ')
      WRITE(*,1065)
 1065 FORMAT(1X,'  FFF       OOOOOOOO  RRR   RR  NN   NNN  UUUUUUUU  ',
     $'   TT     SSSSSSSS  '//)
C
      WRITE(*,1080)
 1080 FORMAT(/1X,'a FORest NUTrient cycling Simulator'/1X,'  ---    ---'
     $,'              -')
C
      WRITE(*,1085)
 1085 FORMAT(///1X,'Designed by Stephen C. Hart and Daniel E. Binkley'/
     $1X,'Programmed by Stephen C. Hart & Revised by John M. Pye'/ 
     $1X,'            Version 2  1985'/1X,' ')
C
      RETURN
      END
C
C
C***********************************************************************
C
